home *** CD-ROM | disk | FTP | other *** search
/ Aminet 21 / Aminet 21 (1997)(GTI - Schatztruhe)[!][Oct 1997].iso / Aminet / misc / emu / iecutil.lha / DtoD64.p < prev    next >
Encoding:
Text File  |  1997-08-19  |  10.1 KB  |  339 lines
  1. program DtoD64;
  2.  
  3. {  Create 15x1 image file directly from 15x1 drive }
  4. {  April 27, 1997  }
  5.  
  6. {$path "inc/"}
  7. {$incl "lib/iec.lib"}
  8.  
  9. type block = array[0..255] of byte;
  10.      track = record
  11.                secs: byte;
  12.                free: array[0..2] of byte
  13.              end;
  14.      entry = record
  15.                fType,
  16.                sT,
  17.                sS: byte
  18.              end;
  19.  
  20. var argsNG, foundFN, fast, useBuffer, MSD, badType, mismatch: Boolean;
  21.     bits, fill, typ: byte;
  22.     size, devyce, buffernum, t, s, entryCount, offs, i, j: integer;
  23.     option: string[8];
  24.     param, outName: string[64];
  25.     trkData: array[1..35] of track;
  26.     im: file of block;
  27.     VTOC, TrackBuffer: block;
  28.     dirData: array[0..127] of entry;
  29.  
  30. function toBlk(trk, sec: integer): integer;
  31.   var b: integer;
  32.   begin
  33.     if (trk < 1) or (trk > 35) or (sec > 20)
  34.         then b := -1
  35.       else if trk < 18
  36.                then b := (trk - 1 ) * 21 + sec
  37.       else if trk < 25
  38.                then b := 357 + (trk - 18) * 19 + sec
  39.       else if trk < 31
  40.                then b := 490 + (trk - 25) * 18 + sec
  41.       else b := 598 + (trk - 31) * 17 + sec;
  42.     if b >= 683
  43.         then toBlk := -1
  44.       else toBlk := b
  45.   end;
  46.  
  47. procedure readSector(t, s: integer);
  48.   var ch: char;
  49.       c, i: integer;
  50.       command: string[16];
  51.   begin
  52.     Listen(devyce);
  53.     Second(CMD_DATA + 15);
  54.     command := 'U1: 2 0 ' + intstr(t) + ' ' + intstr(s);
  55.     for i := 1 to length(command)
  56.       do CIOut(command[i]);
  57.     UnListen;
  58.     Talk(devyce);
  59.     TkSA(CMD_DATA + 2);
  60.     c := 0;
  61.     while IECBase^.iec_ST = ST_OK
  62.       do begin
  63.         TrackBuffer[c] := ord(ACPtr);
  64.         c := c + 1
  65.       end;
  66.     UnTalk;
  67.     writeln(#$9B, '1F', 'Reading: Track ', t, ', ', 'Sector ', s, '  ')
  68.   end;
  69.  
  70. function freeTest(trk: integer): Boolean;
  71.   var b: Boolean;
  72.   begin
  73.     b := true;
  74.     if VTOC[4 + (trk - 1) * 4] = 0
  75.         then b := false { This track has no free sectors }
  76.       else if VTOC[5 + (trk - 1) * 4] = 0
  77.                  then b := false; { Too lazy to search past sector 7 }
  78.     freeTest := b
  79.   end;
  80.  
  81. begin
  82.   trkData[1].secs := 21;
  83.   trkData[2].secs := 21;
  84.   trkData[3].secs := 21;
  85.   trkData[4].secs := 21;
  86.   trkData[5].secs := 21;
  87.   trkData[6].secs := 21;
  88.   trkData[7].secs := 21;
  89.   trkData[8].secs := 21;
  90.   trkData[9].secs := 21;
  91.   trkData[10].secs := 21;
  92.   trkData[11].secs := 21;
  93.   trkData[12].secs := 21;
  94.   trkData[13].secs := 21;
  95.   trkData[14].secs := 21;
  96.   trkData[15].secs := 21;
  97.   trkData[16].secs := 21;
  98.   trkData[17].secs := 21;
  99.   trkData[18].secs := 19;
  100.   trkData[19].secs := 19;
  101.   trkData[20].secs := 19;
  102.   trkData[21].secs := 19;
  103.   trkData[22].secs := 19;
  104.   trkData[23].secs := 19;
  105.   trkData[24].secs := 19;
  106.   trkData[25].secs := 18;
  107.   trkData[26].secs := 18;
  108.   trkData[27].secs := 18;
  109.   trkData[28].secs := 18;
  110.   trkData[29].secs := 18;
  111.   trkData[30].secs := 18;
  112.   trkData[31].secs := 17;
  113.   trkData[32].secs := 17;
  114.   trkData[33].secs := 17;
  115.   trkData[34].secs := 17;
  116.   trkData[35].secs := 17;
  117.   for i := 1 to 35
  118.     do begin
  119.       trkData[i].free[0] := $FF;
  120.       trkData[i].free[1] := $FF;
  121.       case trkData[i].secs of
  122.         17: bits := $01;
  123.         18: bits := $03;
  124.         19: bits := $07;
  125.         21: bits := $1F
  126.       end;
  127.       trkData[i].free[2] := bits
  128.     end;
  129.   devyce := 8;
  130.   fast := false;
  131.   argsNG := false;
  132.   if (ParamCount < 1) or (ParamCount > 3)
  133.       then argsNG := true
  134.     else begin
  135.       foundFN := false;
  136.       for i := 1 to ParamCount
  137.         do begin
  138.           param := ParamStr(i);
  139.           size := length(param);
  140.           if (size = 2) and (param[1] = '-')
  141.               then begin
  142.                 if UpCase(param[2]) <> 'F'
  143.                     then argsNG := true
  144.                   else fast := true
  145.               end
  146.             else if (param = '8')
  147.                     or (param = '9')
  148.                     or (param = '10')
  149.                     or (param = '11')
  150.                      then begin
  151.                        if param[1] = '1'
  152.                            then devyce := ord(param[2]) - 38 { ord('0') + 10 }
  153.                          else devyce := ord(param[1]) - 48 { ord('0') }
  154.                      end
  155.             else if foundFN
  156.                      then argsNG := true
  157.                    else begin
  158.                      outName := param;
  159.                      foundFN := true
  160.                    end
  161.         end
  162.     end;
  163.   if argsNG or not foundFN
  164.       then begin
  165.         writeln('usage: DtoD64 [-f] filename');
  166.         halt(20)
  167.       end;
  168.   OpenIEC;
  169.   { Open the command channel }
  170.   Listen(devyce);        { OPEN 15,8,15 }
  171.   Second(CMD_OPEN + 15);
  172.   if IECBase^.iec_ST <> ST_OK
  173.       then begin
  174.         writeln('Device number ', devyce, ' not responding!')
  175.         halt(20)
  176.       end;
  177.   { Reset the disk controller }
  178.   CIOut('I');                { PRINT#15,"I" }
  179.   UnListen;
  180.   { Open the data channel and allocate a buffer in the 1541 memory }
  181.   Listen(devyce);        { OPEN 2,8,2,"#" }
  182.   Second(CMD_OPEN + 2);
  183.   CIOut('#');
  184.   UnListen;
  185.   { Get the buffer number (unused) }
  186.   Talk(devyce);        { GET #2,buffernum }
  187.   TkSA(CMD_DATA + 2);
  188.   buffernum := ord(ACPtr);
  189.   UnTalk;
  190.   { Open the D64 file to create }
  191.   assign(im, outname + '.D64');
  192.   rewrite(im);
  193.   if fast
  194.       then begin { copy only sectors in use }
  195.         { Determine current formatting }
  196.         writeln('Reading VTOC...');
  197.         writeln;
  198.         readSector(18, 0);
  199.         VTOC := TrackBuffer;
  200.         t := 1;
  201.         useBuffer := freeTest(t);
  202.         if not useBuffer
  203.             then begin
  204.               t := 35;
  205.               useBuffer := freeTest(t)
  206.             end;
  207.         if useBuffer
  208.             then begin
  209.               writeln('Searching for unused sector...');
  210.               writeln;
  211.               bits := VTOC[5 + (t - 1) * 4];
  212.               i := 8;
  213.               repeat
  214.                 i := i - 1
  215.               until bits and (1 shl i) <> 0;
  216.               readSector(t, 7 - i);
  217.               fill := TrackBuffer[1] + TrackBuffer[2] + TrackBuffer[3];
  218.               if fill = 0
  219.                   then begin { Found MSD formatting signature }
  220.                     useBuffer := true;
  221.                     MSD := true
  222.                   end
  223.                 else if fill = 3
  224.                          then begin { Found 1541 formatting signature }
  225.                            useBuffer := true;
  226.                            MSD := false
  227.                          end
  228.                 else useBuffer := false;
  229.             end
  230.         { Create empty image file }
  231.         writeln('Creating empty ''', outName, '.D64''...');
  232.         if not useBuffer
  233.             then begin
  234.               TrackBuffer[0] := $00;
  235.               for i := 1 to 255
  236.                 do TrackBuffer[i] := $01;
  237.               MSD := false
  238.             end;
  239.         for i := 0 to 682
  240.           do begin
  241.             if not MSD and (i = 21)
  242.                  then TrackBuffer[0] := $4B;
  243.             write(im, TrackBuffer)
  244.           end;
  245.         writeln('Writing VTOC...');
  246.         seek(im, toBlk(18, 0));
  247.         write(im, VTOC);
  248.         { Copy directory to image }
  249.         writeln('Copying directory...');
  250.         writeln;
  251.         t := VTOC[0];
  252.         s := VTOC[1];
  253.         entryCount := 0;
  254.         while t <> 0
  255.           do begin
  256.             readSector(t, s);
  257.             seek(im, toBlk(t, s));
  258.             write(im, TrackBuffer);
  259.             t := TrackBuffer[0];
  260.             s := TrackBuffer[1];
  261.             badType := false;
  262.             for i := 0 to 7
  263.               do begin
  264.                 offs := i * 32;
  265.                 typ := TrackBuffer[offs + 2];
  266.                 if not (typ in [$00, $80..$82, $C0..$C2])
  267.                     then badType := true;
  268.                 dirData[entryCount].fType := typ;
  269.                 dirData[entryCount].sT := TrackBuffer[offs + 3];
  270.                 dirData[entryCount].sS := TrackBuffer[offs + 4];
  271.                 entryCount := entryCount + 1
  272.               end
  273.           end;
  274.         if badType
  275.              then begin
  276.                writeln;
  277.                writeln('Found invalid file type!');
  278.                writeln('Repair diskette or omit ''-f'' option')
  279.              end
  280.           else begin { Copy files to image }
  281.             writeln('Copying files...');
  282.             writeln;
  283.             for i := 0 to entryCount - 1
  284.               do begin
  285.                 typ := dirData[i].fType;
  286.                 if (typ = $81) or (typ = $82) or (typ = $C1) or (typ = $C2)
  287.                     then begin
  288.                       t := dirData[i].sT;
  289.                       s := dirData[i].sS;
  290.                       while t <> 0
  291.                         do begin
  292.                           readSector(t, s);
  293.                           seek(im, toBlk(t, s));
  294.                           write(im, TrackBuffer);
  295.                           trkData[t].secs := trkData[t].secs - 1;
  296.                           j := s div 8;
  297.                           trkData[t].free[j] := trkData[t].free[j]
  298.                                                  xor (1 shl (s mod 8));
  299.                           t := TrackBuffer[0];
  300.                           s := TrackBuffer[1]
  301.                         end;
  302.                     end
  303.               end
  304.             mismatch := false;
  305.             for i := 1 to 17
  306.               do if trkData[i].secs <> VTOC[4 + (i - 1) * 4]
  307.                      then mismatch := true
  308.                    else for j := 0 to 2
  309.                           do if trkData[i].free[j] <> VTOC[5 + (i - 1) * 4 + j]
  310.                                  then mismatch := true;
  311.             for i := 19 to 35
  312.               do if trkData[i].secs <> VTOC[4 + (i - 1) * 4]
  313.                      then mismatch := true
  314.                    else for j := 0 to 2
  315.                           do if trkData[i].free[j] <> VTOC[5 + (i - 1) * 4 + j]
  316.                                  then mismatch := true;
  317.           end { Copy files to image }
  318.       end { copy only sectors in use }
  319.     else begin { copy all sectors }
  320.       writeln;
  321.       for t := 1 to 35
  322.         do for s := 0 to trkData[t].secs - 1
  323.              do begin
  324.                readSector(t, s);
  325.                write(im, TrackBuffer)
  326.              end
  327.     end; { copy all sectors }
  328.   close(im);
  329.   Listen(devyce);        { Close 2 }
  330.   Second(CMD_CLOSE + 2);
  331.   UnListen;
  332.   Listen(devyce);        { Close 15 }
  333.   Second(CMD_CLOSE + 15);
  334.   UnListen;
  335.   writeln;
  336.   if fast and mismatch
  337.       then writeln('Space occupied by source diskette files does not match original VTOC')
  338. end.
  339.